#network library
require(visNetwork, quietly = TRUE)
package 㤼㸱visNetwork㤼㸲 was built under R version 3.4.4
library(reshape)
package 㤼㸱reshape㤼㸲 was built under R version 3.4.4
Attaching package: 㤼㸱reshape㤼㸲
The following object is masked from 㤼㸱package:dplyr㤼㸲:
rename
#we created a mirrored matrix, so we need to clean part of it (lower triangle), otherwise we´ll have duplicated values
new_matrix <- (Product_Matrix)
new_matrix[lower.tri(new_matrix)] <- NA
#View(new_matrix)
#create nodes and edges
nodes <- data.frame(id=colnames(Product_Matrix)[1:ncol(Product_Matrix)])
edges <- (melt(as.matrix(new_matrix)))
colnames(edges) <- c("from","to","value")
#View(nodes)
#View(edges)
#format edges$value to number
edges$value <- as.numeric(edges$value)
#delete NA values
edges <- edges[((!is.na(edges$value)) & edges$value>0),]
nodes$label <- nodes$id
edges$label <- edges$value
net_graph <- visNetwork(nodes, edges,height = "700px", width = "100%") %>%
visIgraphLayout() %>%
visNodes(size = 30) %>%
visOptions(highlightNearest = TRUE,
nodesIdSelection = TRUE) %>%
visInteraction(keyboard = TRUE,
dragNodes = T,
dragView = T,
zoomView = T)
#view network graph
net_graph
#save network graph in html file
htmlwidgets::saveWidget(net_graph, "net_graph.html")
#matrix bargraph
barplot(Product_Matrix,beside=TRUE, legend=TRUE)

library(plotly)
Carregando pacotes exigidos: ggplot2
package 㤼㸱ggplot2㤼㸲 was built under R version 3.4.4Want to understand how all the pieces fit together? See the R for Data Science book:
http://r4ds.had.co.nz/
Attaching package: 㤼㸱plotly㤼㸲
The following object is masked from 㤼㸱package:ggplot2㤼㸲:
last_plot
The following object is masked from 㤼㸱package:reshape㤼㸲:
rename
The following object is masked from 㤼㸱package:stats㤼㸲:
filter
The following object is masked from 㤼㸱package:graphics㤼㸲:
layout
#create a new data frame, to rank the frequency from edges dataframe
df_rank <- edges
#create a new column 'Description' joining columns 'From' and 'To'
df_rank$Description <- ifelse(df_rank$from != df_rank$to, paste(df_rank$from, df_rank$to, sep = " + "), as.character(df_rank$from))
#order dataframe by value
df_rank <- df_rank[order(-df_rank$value),]
#top 10 values
if (nrow(df_rank)>=10){
df_rank_10 <- df_rank[1:10,]
}else{
df_rank_10 <- df_rank
}
plot_ly(data = df_rank_10,
x = ~Description,
y = ~value,
type = "bar"
) %>%
layout(
title = "Frequency rank of product combinations",
xaxis = list(title = "",
categoryorder = "array",
categoryarray = ~value,
tickangle=-45),
yaxis = list(title = "Sum of occurrences"),
margin = list(b = 200)
)
#heatmap
library(plotly)
data=as.matrix(Product_Matrix)
hm1 <- plot_ly(x=colnames(data), y=rownames(data), z = data, type = "heatmap")
# with normalization
data=apply(data, 2, function(x){x/mean(x)})
plot_ly(x=colnames(data), y=rownames(data), z = data, type = "heatmap")
#save network graph in html file
htmlwidgets::saveWidget(hm1, "heatmap1.html")
#export result
write.csv(df_rank,"Output/rank-combinations.csv")
library(ggplot2)
df_hm <- df_rank[,(1:3)]
ggplot(data = df_hm, aes(x=from, y=to, fill=value)) +
geom_tile()

#correlation of occurrences
cormat <- round(cor(Product_Matrix),2)
head(cormat)
Pants Shoes Socks t-shirt
Pants 1.00 -0.17 0.82 -0.58
Shoes -0.17 1.00 -0.43 0.90
Socks 0.82 -0.43 1.00 -0.71
t-shirt -0.58 0.90 -0.71 1.00
library(reshape2)
Attaching package: 㤼㸱reshape2㤼㸲
The following objects are masked from 㤼㸱package:reshape㤼㸲:
colsplit, melt, recast
melted_cormat <- melt(cormat)
head(melted_cormat)
library(ggplot2)
ggplot(data = melted_cormat, aes(x=X1, y=X2, fill=value)) +
geom_tile()

LS0tDQp0aXRsZTogIlN0ZXAgMyAtIENyZWF0ZSBhIG5ldHdvcmsgZ3JhcGgvaGVhdG1hcC9iYXJncmFwaCBmcm9tIHNxdWFyZSBtYXRyaXgiDQphdXRob3I6ICJMdWNpYW5vIEZpcnBvIg0KZGF0ZTogJzIwMTktMDEtMjEnDQpvdXRwdXQ6DQogIG1kX2RvY3VtZW50Og0KICAgIHZhcmlhbnQ6IG1hcmtkb3duX2dpdGh1Yg0KICBodG1sX25vdGVib29rOg0KICAgIHRoZW1lOiB1bml0ZWQNCiAgICB0b2M6IHllcw0KICAgIHRvY19kZXB0aDogMw0KLS0tDQoNCg0KYGBge3J9DQojbmV0d29yayBsaWJyYXJ5DQpyZXF1aXJlKHZpc05ldHdvcmssIHF1aWV0bHkgPSBUUlVFKQ0KbGlicmFyeShyZXNoYXBlKQ0KDQojd2UgY3JlYXRlZCBhIG1pcnJvcmVkIG1hdHJpeCwgc28gd2UgbmVlZCB0byBjbGVhbiBwYXJ0IG9mIGl0IChsb3dlciB0cmlhbmdsZSksIG90aGVyd2lzZSB3ZcK0bGwgaGF2ZSBkdXBsaWNhdGVkIHZhbHVlcw0KbmV3X21hdHJpeCA8LSAoUHJvZHVjdF9NYXRyaXgpDQpuZXdfbWF0cml4W2xvd2VyLnRyaShuZXdfbWF0cml4KV0gPC0gTkENCg0KI1ZpZXcobmV3X21hdHJpeCkNCg0KI2NyZWF0ZSBub2RlcyBhbmQgZWRnZXMNCm5vZGVzIDwtIGRhdGEuZnJhbWUoaWQ9Y29sbmFtZXMoUHJvZHVjdF9NYXRyaXgpWzE6bmNvbChQcm9kdWN0X01hdHJpeCldKQ0KZWRnZXMgPC0gKG1lbHQoYXMubWF0cml4KG5ld19tYXRyaXgpKSkNCmNvbG5hbWVzKGVkZ2VzKSA8LSBjKCJmcm9tIiwidG8iLCJ2YWx1ZSIpDQojVmlldyhub2RlcykNCiNWaWV3KGVkZ2VzKQ0KDQojZm9ybWF0IGVkZ2VzJHZhbHVlIHRvIG51bWJlcg0KZWRnZXMkdmFsdWUgPC0gYXMubnVtZXJpYyhlZGdlcyR2YWx1ZSkNCg0KI2RlbGV0ZSBOQSB2YWx1ZXMNCmVkZ2VzIDwtIGVkZ2VzWygoIWlzLm5hKGVkZ2VzJHZhbHVlKSkgJiBlZGdlcyR2YWx1ZT4wKSxdDQoNCg0Kbm9kZXMkbGFiZWwgPC0gbm9kZXMkaWQNCmVkZ2VzJGxhYmVsIDwtIGVkZ2VzJHZhbHVlDQoNCg0KbmV0X2dyYXBoIDwtIHZpc05ldHdvcmsobm9kZXMsIGVkZ2VzLGhlaWdodCA9ICI3MDBweCIsIHdpZHRoID0gIjEwMCUiKSAlPiUNCiAgdmlzSWdyYXBoTGF5b3V0KCkgJT4lDQogIHZpc05vZGVzKHNpemUgPSAzMCkgJT4lDQogIHZpc09wdGlvbnMoaGlnaGxpZ2h0TmVhcmVzdCA9IFRSVUUsDQogICAgICAgICAgICAgbm9kZXNJZFNlbGVjdGlvbiA9IFRSVUUpICU+JQ0KICB2aXNJbnRlcmFjdGlvbihrZXlib2FyZCA9IFRSVUUsDQogICAgICAgICAgICAgICAgIGRyYWdOb2RlcyA9IFQsIA0KICAgICAgICAgICAgICAgICBkcmFnVmlldyA9IFQsIA0KICAgICAgICAgICAgICAgICB6b29tVmlldyA9IFQpDQoNCg0KYGBgDQoNCmBgYHtyfQ0KI3ZpZXcgbmV0d29yayBncmFwaA0KbmV0X2dyYXBoDQpgYGANCg0KYGBge3J9DQojc2F2ZSBuZXR3b3JrIGdyYXBoIGluIGh0bWwgZmlsZQ0KaHRtbHdpZGdldHM6OnNhdmVXaWRnZXQobmV0X2dyYXBoLCAibmV0X2dyYXBoLmh0bWwiKQ0KYGBgDQpgYGB7cn0NCiNtYXRyaXggYmFyZ3JhcGgNCmJhcnBsb3QoUHJvZHVjdF9NYXRyaXgsYmVzaWRlPVRSVUUsIGxlZ2VuZD1UUlVFKSANCmBgYA0KDQpgYGB7cn0NCmxpYnJhcnkocGxvdGx5KQ0KDQojY3JlYXRlIGEgbmV3IGRhdGEgZnJhbWUsIHRvIHJhbmsgdGhlIGZyZXF1ZW5jeSBmcm9tIGVkZ2VzIGRhdGFmcmFtZQ0KDQpkZl9yYW5rIDwtIGVkZ2VzDQoNCiNjcmVhdGUgYSBuZXcgY29sdW1uICdEZXNjcmlwdGlvbicgam9pbmluZyBjb2x1bW5zICdGcm9tJyBhbmQgJ1RvJw0KZGZfcmFuayREZXNjcmlwdGlvbiA8LSBpZmVsc2UoZGZfcmFuayRmcm9tICE9IGRmX3JhbmskdG8sIHBhc3RlKGRmX3JhbmskZnJvbSwgZGZfcmFuayR0bywgc2VwID0gIiArICIpLCBhcy5jaGFyYWN0ZXIoZGZfcmFuayRmcm9tKSkNCg0KI29yZGVyIGRhdGFmcmFtZSBieSB2YWx1ZQ0KZGZfcmFuayA8LSBkZl9yYW5rW29yZGVyKC1kZl9yYW5rJHZhbHVlKSxdDQoNCiN0b3AgMTAgdmFsdWVzDQppZiAobnJvdyhkZl9yYW5rKT49MTApew0KICBkZl9yYW5rXzEwIDwtIGRmX3JhbmtbMToxMCxdDQp9ZWxzZXsNCiAgZGZfcmFua18xMCA8LSBkZl9yYW5rDQp9DQoNCnBsb3RfbHkoZGF0YSA9IGRmX3JhbmtfMTAsDQogICAgIHggPSB+RGVzY3JpcHRpb24sDQogICAgIHkgPSB+dmFsdWUsDQogICAgIHR5cGUgPSAiYmFyIg0KKSAlPiUNCmxheW91dCgNCiAgICAgdGl0bGUgPSAiRnJlcXVlbmN5IHJhbmsgb2YgcHJvZHVjdCBjb21iaW5hdGlvbnMiLA0KICAgICB4YXhpcyA9IGxpc3QodGl0bGUgPSAiIiwNCiAgICAgICAgICAgICAgICAgIGNhdGVnb3J5b3JkZXIgPSAiYXJyYXkiLA0KICAgICAgICAgICAgICAgICAgY2F0ZWdvcnlhcnJheSA9IH52YWx1ZSwNCiAgICAgICAgICAgICAgICAgIHRpY2thbmdsZT0tNDUpLA0KICAgICB5YXhpcyA9IGxpc3QodGl0bGUgPSAiU3VtIG9mIG9jY3VycmVuY2VzIiksDQogICAgIG1hcmdpbiA9IGxpc3QoYiA9IDIwMCkNCikNCg0KYGBgDQoNCmBgYHtyfQ0KI2hlYXRtYXANCg0KbGlicmFyeShwbG90bHkpDQogDQpkYXRhPWFzLm1hdHJpeChQcm9kdWN0X01hdHJpeCkNCg0KaG0xIDwtIHBsb3RfbHkoeD1jb2xuYW1lcyhkYXRhKSwgeT1yb3duYW1lcyhkYXRhKSwgeiA9IGRhdGEsIHR5cGUgPSAiaGVhdG1hcCIpDQogDQojIHdpdGggbm9ybWFsaXphdGlvbg0KZGF0YT1hcHBseShkYXRhLCAyLCBmdW5jdGlvbih4KXt4L21lYW4oeCl9KQ0KcGxvdF9seSh4PWNvbG5hbWVzKGRhdGEpLCB5PXJvd25hbWVzKGRhdGEpLCB6ID0gZGF0YSwgdHlwZSA9ICJoZWF0bWFwIikNCg0KYGBgDQoNCmBgYHtyfQ0KI3NhdmUgbmV0d29yayBncmFwaCBpbiBodG1sIGZpbGUNCmh0bWx3aWRnZXRzOjpzYXZlV2lkZ2V0KGhtMSwgImhlYXRtYXAxLmh0bWwiKQ0KYGBgDQoNCg0KYGBge3J9DQojZXhwb3J0IHJlc3VsdA0Kd3JpdGUuY3N2KGRmX3JhbmssIk91dHB1dC9yYW5rLWNvbWJpbmF0aW9ucy5jc3YiKQ0KDQpgYGANCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KDQpkZl9obSA8LSBkZl9yYW5rWywoMTozKV0NCg0KZ2dwbG90KGRhdGEgPSBkZl9obSwgYWVzKHg9ZnJvbSwgeT10bywgZmlsbD12YWx1ZSkpICsgDQogIGdlb21fdGlsZSgpDQpgYGANCmBgYHtyfQ0KI2NvcnJlbGF0aW9uIG9mIG9jY3VycmVuY2VzDQoNCmNvcm1hdCA8LSByb3VuZChjb3IoUHJvZHVjdF9NYXRyaXgpLDIpDQpoZWFkKGNvcm1hdCkNCg0KbGlicmFyeShyZXNoYXBlMikNCm1lbHRlZF9jb3JtYXQgPC0gbWVsdChjb3JtYXQpDQpoZWFkKG1lbHRlZF9jb3JtYXQpDQoNCmxpYnJhcnkoZ2dwbG90MikNCmdncGxvdChkYXRhID0gbWVsdGVkX2Nvcm1hdCwgYWVzKHg9WDEsIHk9WDIsIGZpbGw9dmFsdWUpKSArIA0KICBnZW9tX3RpbGUoKQ0KDQpgYGANCg0K